home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
dosver1r
/
starfiel.bas
< prev
next >
Wrap
BASIC Source File
|
1999-04-23
|
5KB
|
127 lines
Attribute VB_Name = "Starfields"
Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Const WarpStarSpeed = 100
Type Stars
SpeedY As Integer
SpeedX As Integer
StarX As Integer
StarY As Integer
StarColor As Byte
End Type
Public SpecialEffectX As Integer
Public SpecialEffectY As Integer
Public Star() As Stars 'Array of Stars Type
Public StarCount As Integer ' holds the amount of stars in array
Public Status As String 'holds Name of the current effect
Sub ReDimStars(HowManyStars As Integer)
'call this to reset the amount of stars, MAX = 32,767
StarCount = HowManyStars
ReDim Star(0 To HowManyStars)
End Sub
Sub AddStars(NumberToAdd As Integer, WhatHeight As Integer, WhatWidth As Integer)
'call this to add more stars, MAX = 32,767
Dim NewAmount As Integer, Starloop As Integer
NewAmount = StarCount + NumberToAdd
ReDim Preserve Star(0 To NewAmount)
Select Case Status
Case "Snow"
For Starloop = StarCount To NewAmount
Star(Starloop).StarX = 0
Star(Starloop).StarX = Int(Rnd * WhatWidth)
Star(Starloop).StarColor = 15
Star(Starloop).SpeedY = Int(Rnd * 3) + 1
Next Starloop
StarCount = NewAmount
End Select
End Sub
Sub StarSetup(WhatHeight As Integer, WhatWidth As Integer)
Dim i As Integer, j As Integer
If StarCount = Null Or StarCount = 0 Then Exit Sub
Select Case Status
Case "Snow"
For i = 0 To StarCount
Star(i).StarColor = 15
Star(i).StarX = Int(Rnd * WhatWidth)
Star(i).StarY = Int(Rnd * WhatHeight)
Star(i).SpeedY = Int(Rnd * 3) + 1
Next i
Case "Stars"
For i = 0 To StarCount
Star(i).StarColor = Int(Rnd * 15) + 1
Star(i).StarX = Int(Rnd * WhatWidth)
Star(i).StarY = Int(Rnd * WhatHeight)
Star(i).SpeedY = Int(Rnd * 7) + 1
Next i
Case "Black Hole"
For i = 0 To StarCount
Star(i).StarColor = Int(Rnd * 15) + 1
Star(i).StarX = Int(WhatWidth / 2)
Star(i).StarY = Int(WhatHeight / 2)
Star(i).SpeedY = Int(Rnd * WarpStarSpeed) - (WarpStarSpeed / 2)
Star(i).SpeedX = Int(Rnd * WarpStarSpeed) - (WarpStarSpeed / 2)
Do While Star(i).SpeedX = 0 Or Star(i).SpeedY = 0
Randomize
Star(i).SpeedY = Int(Rnd * WarpStarSpeed) - (WarpStarSpeed / 2)
Star(i).SpeedX = Int(Rnd * WarpStarSpeed) - (WarpStarSpeed / 2)
Loop
For j = 0 To 30
NextStarPosition i, WhatWidth, WhatHeight
Next j
Next i
End Select
End Sub
Sub NextStarPosition(StarNumber As Integer, WhatHeight As Integer, WhatWidth As Integer)
Select Case Status
Case "Snow"
Star(StarNumber).StarY = Star(StarNumber).StarY + Star(StarNumber).SpeedY
Star(StarNumber).StarX = Star(StarNumber).StarX + Int(5 * Rnd) - 2
If Star(StarNumber).StarX > WhatWidth Then Star(StarNumber).StarX = 0
If Star(StarNumber).StarX < 0 Then Star(StarNumber).StarX = WhatWidth
If Star(StarNumber).StarY > WhatHeight Then
Star(StarNumber).SpeedY = Int(2 * Rnd) + 1
Star(StarNumber).StarY = Star(StarNumber).SpeedY
Star(StarNumber).StarColor = 15
End If
Case "Stars"
Star(StarNumber).StarY = Star(StarNumber).StarY + Star(StarNumber).SpeedY
If Star(StarNumber).StarY > WhatHeight Then
Star(StarNumber).SpeedY = Int(7 * Rnd) + 2
Star(StarNumber).StarY = Star(StarNumber).SpeedY
Star(StarNumber).StarColor = Int(Rnd * 15) + 1
End If
Case "Black Hole"
If Star(StarNumber).StarY > WhatHeight Or Star(StarNumber).StarX > WhatWidth Or Star(StarNumber).StarY < 0 Or Star(StarNumber).StarX < 0 Then
Star(StarNumber).StarX = SpecialEffectX 'Int(WhatWidth / 2) + SpecialEffectX
Star(StarNumber).StarY = SpecialEffectY 'Int(WhatHeight / 2) + SpecialEffectY
Randomize
Star(StarNumber).SpeedX = Int(Rnd * WarpStarSpeed) - (WarpStarSpeed / 2)
Star(StarNumber).SpeedY = Int(Rnd * WarpStarSpeed) - (WarpStarSpeed / 2)
Do While (Star(StarNumber).SpeedX = Star(StarNumber).SpeedY Or Star(StarNumber).SpeedX = 0 Or Star(StarNumber).SpeedY = 0)
Randomize
Star(StarNumber).SpeedX = Int(Rnd * WarpStarSpeed) - (WarpStarSpeed / 2)
Star(StarNumber).SpeedY = Int(Rnd * WarpStarSpeed) - (WarpStarSpeed / 2)
Loop
End If
Star(StarNumber).StarY = Star(StarNumber).StarY + (Star(StarNumber).SpeedY)
Star(StarNumber).StarX = Star(StarNumber).StarX + (Star(StarNumber).SpeedX)
End Select
End Sub